home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / timer.cls < prev    next >
Text File  |  1997-06-14  |  2KB  |  89 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CTimer"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Private iInterval As Long
  13. Private id As Long
  14.  
  15. ' User can attach any Variant data they want to the timer
  16. Public Item As Variant
  17.  
  18. Public Event ThatTime()
  19.  
  20. ' SubTimer is independent of VBCore, so it hard codes error handling
  21.  
  22. Public Enum EErrorTimer
  23.     eeBaseTimer = 13650     ' CTimer
  24.     eeTooManyTimers         ' No more than 10 timers allowed
  25.     eeCantCreateTimer       ' Can't create system timer
  26. End Enum
  27.  
  28. Friend Sub ErrRaise(e As Long)
  29.     Dim sText As String, sSource As String
  30.     If e > 1000 Then
  31.         sSource = App.EXEName & ".WindowProc"
  32.         Select Case e
  33.         Case eeTooManyTimers
  34.             sText = "No more than 10 timers allowed"
  35.         Case eeCantCreateTimer
  36.             sText = "Can't create system timer"
  37.         End Select
  38.         Err.Raise e Or vbObjectError, sSource, sText
  39.     Else
  40.         ' Raise standard Visual Basic error
  41.         Err.Raise e, sSource
  42.     End If
  43. End Sub
  44.  
  45.  
  46. Property Get Interval() As Long
  47.     Interval = iInterval
  48. End Property
  49.  
  50. ' Can't just change interval--you must kill timer and start a new one
  51. Property Let Interval(iIntervalA As Long)
  52.     Dim f As Boolean
  53.     If iIntervalA Then
  54.         ' Don't mess with it if interval is the same
  55.         If iInterval = iIntervalA Then Exit Property
  56.         ' Must destroy any existing timer to change interval
  57.         If iInterval Then
  58.             f = TimerDestroy(Me)
  59.             BugAssert f     ' Shouldn't fail
  60.         End If
  61.         ' Create new timer with new interval
  62.         iInterval = iIntervalA
  63.         If TimerCreate(Me) = False Then ErrRaise eeCantCreateTimer
  64.     Else
  65.         iInterval = iIntervalA
  66.         f = TimerDestroy(Me)
  67.         BugAssert f     ' Shouldn't fail
  68.     End If
  69. End Property
  70.  
  71. ' Must be public so that Timer object can't terminate while client's ThatTime
  72. ' event is being processed--Friend wouldn't prevent this disaster
  73. Public Sub PulseTimer()
  74. Attribute PulseTimer.VB_MemberFlags = "40"
  75.     RaiseEvent ThatTime
  76. End Sub
  77.  
  78. Friend Property Get TimerID() As Long
  79.     TimerID = id
  80. End Property
  81.  
  82. Friend Property Let TimerID(idA As Long)
  83.     id = idA
  84. End Property
  85.  
  86. Private Sub Class_Terminate()
  87.     Interval = 0
  88. End Sub
  89.